home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
QRZ! Ham Radio 8
/
QRZ Ham Radio Callsign Database - Volume 8.iso
/
pc
/
files
/
mac
/
proj_a1.hqx
/
Project Mac - A1
/
Ham Grid Dist & Direction
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1987-12-04
|
4KB
|
152 lines
' ********************************************************
' * This program is from "The ARRL World Grid Locator Atlas" *
' * Copyright 1984 Folke Rosval, SM5AGM. This atlas is Available *
' * from ARRL HQ for $4.00 . This program entered and modified for the * *
' * Macintosh by Jim Bradbury, WB5ACL / DA2ND, December 1987 *
' ********************************************************
PRINT "This Program computes Direction and Distance between"
PRINT "two Grid Locations."
PRINT
100 X0=6378.14
X1=6356.75
X2=0.014
X3=1.8
X4=4
X5=2*ATN(1)
X6=2*X5
X7=2*X6
110 X8=X5/90
A = X0*X0
B = X1 * X1
B = 1 + (A-B)/B
C = SQR(B)
A = A/X1
X9 = (1+1/C/B)*A/2
120 Y0=A-X9
Y1=(X0+A)/2
Y2=A-Y1
Y3=(2*X9/X0-1)*X6
Y4=X0-X9
Y5=X7*(1-X9/X0)
130 YD5=Y5*Y5
140 PRINT "Grid Locations can be:"
PRINT "Two Letters -> ";
<0x10c262d,0x07>(12):<0x1a,0x00>(0):<0x1a,0x01>(0):PRINT"JN"
<0x10c2672,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
PRINT "Two Letters and Two Numbers -> ";
<0x10c26fb,0x07>(12):<0x1d,0x00>(0):<0x1d,0x01>(0):PRINT "JN49"
<0x10c2743,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
PRINT "or, Two Letters, Two Numbers, and Two Letters -> ";
<0x10c27c3,0x07>(12):<0x1f,0x00>(0):<0x1f,0x01>(0):PRINT "JN49GL"
<0x10c280d,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
PRINT
INPUT"Enter FROM Grid Location " ;A$
LOC1$=A$
GOSUB 290
IF E = 1 THEN E = 0: GOTO 140
150 A = C * X8
B = D * X8
160 INPUT "Enter TO Grid Location ";A$
LOC2$=A$
GOSUB 290
IF E = 1 THEN E = 0: GOTO 160
170 C=C*X8
D=D*X8
E=C-A
F=SIN(B)
G=SIN(D)
H=COS(B)
I=COS(D)
J=COS(E)
180 K = F*G+H*I*J
GOSUB 370
M = L
IF ABS(K) < 1 THEN N = (G*H-I*F*J)/SQR(1-K*K)
190 K = N
GOSUB 370
G = L
I = M/X4
J = -I/3
P = 0
FOR Q = 1 TO 4
J = J + I
K = COS(J)*F+SIN(J)*H*N
GOSUB 370
R = 0
IF L <> 0 THEN R = H*SIN(G)/SIN(L)
S = R * X5
IF ABS(R) < 1 THEN S = ATN(R/SQR(1-R*R))
R = COS(2*L)
T = X9 + Y0*R
R = Y1 + Y2*R
P = P + (T+R)/2 + (T-R)/2*COS(2*S)
NEXT
F = P / X4
H = 0
I = M-Y3
IF I > 0 THEN H = I*I*(F-X9)/Y5
240 I = SIN(X6*(X0-F)/Y4)
J = Y3*(1-X2*I)
IF M > J THEN H = H +X3*I*SIN(X6*SQR((X6-M)/(X6-J)))
F = (F-H)*M
IF F < 0.5 OR F > 20003.5 THEN G = 0: GOTO 280
270 IF E * (X6-ABS(E)) < 0 THEN G = X7-G
280 PRINT
PRINT "From Grid location ";
<0x10c2dfe,0x07>(12):<0x1b,0x00>(0):<0x1b,0x01>(0):PRINT LOC1$
<0x10c2e45,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
PRINT " to location ";
<0x10c2eaa,0x07>(12):<0x1b,0x00>(0):<0x1b,0x01>(0):PRINT LOC2$
<0x10c2ef1,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
PRINT " The Direction is ";
<0x10c2f50,0x07>(12):<0x2d,0x00>(0):<0x2d,0x01>(0):PRINT INT(G/X8+0.5);"í,";
<0x10c2fa5,0x07>(12):<0x14,0x00>(0):<0x14,0x01>(9)
PRINT " and the Distance is ";
<0x10c3007,0x07>(12):<0x24,0x00>(0):<0x24,0x01>(0):PRINT INT(F+0.5);
PRINT "Kilometers."
<0x10c3070,0x07>(12):<0x1d,0x00>(0):<0x1d,0x01>(9):PRINT:GOTO 160
290 F = LEN(A$)
IF F <> 2 AND F <> 4 AND F <> 6 THEN E = 1: RETURN
300 FOR G = 1 TO F
A(G) = ASC(MID$(A$,G,1))
NEXT
' IF Lower Case, Change to Upper Case
FOR G = 1 TO F
IF A(G) > 82 THEN A(G) = A(G) - 32
NEXT
310 IF A(1) < 65 OR A(1) > 82 OR A(2) < 65 OR A(2) > 82 THEN E = 1: RETURN
320 C = A(1) *20-1480
D = A(2) * 10 - 740
IF F = 2 THEN C = C+ 10 : D = D + 5: RETURN
330 IF A(3) < 48 OR A(3) > 57 OR A(4) < 48 OR A(4) > 57 THEN E = 1:RETURN
340 C = C + A(3)*2-96
D = D + A(4)-48
IF F = 4 THEN C = C + 1: D = D + 0.5: RETURN
350 IF A(5) < 65 OR A(5) > 88 OR A(6) < 65 OR A(6) > 88 THEN E = 1: RETURN
360 C = C+(A(5)-64.5) / 12
D = D + (A(6)-64.5)/24
RETURN
370 IF K > 1 THEN K = 1: L = 0: RETURN
380 IF K <= -1 THEN K = -1: L = X6: RETURN
390 L = X5-ATN(K/SQR(1-K*K)): RETURN